Loadstar 123/123.d81/hex calc.basic

Commodore BASIC | 2022-08-26 | 9KB | 460 lines

10 poke56,56:poke52,56:clr
12 poke53281,0:poke53280,0:print"[147]":ti$="000000":gosub60000
14 ifti$<"000005"then14
20 tp$="[145]                    [176][192][192][192][174][176][192][192][192][174][176][192][192][192][174][176][192][192][192][174]"
30 bt$="[145]                    [173][192][192][192][189][173][192][192][192][189][173][192][192][192][189][173][192][192][192][189]"
100 dv=peek(186):ifdv<8thendv=8
200 rem  sys57812"calc font",dv,0:poke780,0:poke781,0:poke782,56:sys65493
220 print"[147]"chr$(142)
230 poke53281,0:poke646,0:poke53272,25:poke788,52
232 gosub5000
240 dim k%(27),vm(19,4)
250 gosub 3600:rem initialize k%
260 rem calculator
270 rem md=-1 for decimal
280 rem md= 1 for hexadecimal
290 rem ee=1 means input evaluated
300 rem ee=0 means evaluation needed
310 rem ee=-1 means eval done after unary operator
320 rem k0% holds keypress to turn off
330 rem k1% holds keypress to turn on
340 rem k2% holds 2nd key to turn off
350 rem k3% holds old operator key
360 rem note: -1 means skip turning on/off
370 op=0:rem null operator
380 md=-1:ba=10:t1=0:t2=0:tm=0:la=2:ee=1:er=0
390 k0%=-1:k1%=-1:k2%=-1:k3%=-1
400 poke214,0:print:printtab(24)"";
410 a$="":get a$:if a$="" then 410
412 xq=pos(1):poke781,24:sys59903:poke214,0:print:printtab(xq)"";
420 if er then 1990
430 if a$<"0" or a$>"9"then 560
440 if ee then gosub 3210:ee=0
450 if la>=9 then 410
460 if md>0 and la>=5 then 410
470 la=la+1
480 t$(la)=a$
490 t2=0
500 print a$;
510 k0%=k1%
520 k1%=asc(a$)-48
530 k2%=-1
540 goto 2240
550 rem check hex digits
560 if a$<"a" or a$>"f" then 690
570 if md<0 then 410
580 if ee then gosub 3210:ee=0
590 if la>=5 then 410
600 la=la+1
610 t$(la)=a$
620 t2=0
630 print a$;
640 k0%=k1%
650 k1%=asc(a$)-55
660 k2%=-1
670 goto 2240
680 rem evaluate addition
690 if a$<>"+" then 780
700 if ee<=0 then gosub 2470
710 op=1
720 k0%=k1%
730 k1%=19
740 k2%=k3%
750 k3%=k1%
760 goto 2240
770 rem evaluate subtraction
780 if a$<>"-" then 870
790 if ee<=0 then gosub 2470
800 op=2
810 k0%=k1%
820 k1%=18
830 k2%=k3%
840 k3%=k1%
850 goto 2240
860 rem evaluate multiplication
870 if a$<>"*" then 960
880 if ee<=0 then gosub 2470
890 op=3
900 k0%=k1%
910 k1%=16
920 k2%=k3%
930 k3%=k1%
940 goto 2240
950 rem evaluate division
960 if a$<>"/" then 1050
970 if ee<=0 then gosub 2470
980 op=4
990 k0%=k1%
1000 k1%=17
1010 k2%=k3%
1020 k3%=k1%
1030 goto 2240
1040 rem evaluate result
1050 if a$<>"=" then 1150
1060 if ee<=0 then gosub 2470
1070 op=0
1080 t2=tm
1090 k0%=k1%
1100 k1%=20
1110 k2%=k3%
1120 k3%=k1%
1130 goto 2240
1140 rem evaluate complement
1150 if a$<>"@" then 1290
1160 if ee=0 then gosub 3290:ee=-1
1170 if er then 1240
1180 t0=-t1
1190 if ee>0 then t0=-tm
1200 gosub 3210
1210 gosub 2810
1220 if ee<=0 then t1=t0
1230 if ee>0 then tm=t0
1240 k0%=k1%
1250 k1%=22
1260 k2%=-1
1270 goto 2240
1280 rem evaluate base conversion
1290 if a$<>"_" then 1530
1300 if ee=0 then gosub 3290:ee=-1
1310 if er then 1480
1320 md=-md
1330 t0=t1
1340 if ee>0 then t0=tm
1350 if md>0 then 1410
1360 ba=10
1370 poke 1100,4
1380 poke 1101,5
1390 poke 1102,3
1400 goto 1450
1410 ba=16
1420 poke 1100,8
1430 poke 1101,5
1440 poke 1102,24
1450 gosub 3210
1460 gosub 2810:rem display t0
1470 if ee>0 then tm=t0:t2=t0
1480 k0%=k1%
1490 k1%=23
1500 k2%=-1
1510 goto 2240
1520 rem evaluate delete
1530 if a$<>chr$(20) then 1620
1540 if ee or la<=0 then 410
1550 la=la-1
1560 print"[157] [157]";
1570 k0%=k1%
1580 k1%=-1:rem turn off only
1590 k2%=-1
1600 goto 2240
1610 rem evaluate and
1620 if a$<>"&" then 1710
1630 if ee<=0 then gosub 2470
1640 op=5
1650 k0%=k1%
1660 k1%=24
1670 k2%=k3%
1680 k3%=k1%
1690 goto 2240
1700 rem evaluate or
1710 if a$<>"%" then 1800
1720 if ee<=0 then gosub 2470
1730 op=6
1740 k0%=k1%
1750 k1%=25
1760 k2%=k3%
1770 k3%=k1%
1780 goto 2240
1790 rem evaluate not
1800 if a$<>"#" then 1990
1810 if ee=0 then gosub 3290:ee=-1
1820 if er then 1940
1830 rem normalize argument
1840 if ee>0 then 1880
1850 if t1>32767 then t1=t1-65536
1860 t0=not t1
1870 goto 1900
1880 if tm>32767 then tm=tm-65536
1890 t0=not tm
1900 gosub 3210
1910 gosub 2810
1920 if ee<=0 then t1=t0
1930 if ee>0 then tm=t0
1940 k0%=k1%
1950 k1%=26
1960 k2%=-1
1970 goto 2240
1980 rem evaluate clear
1990 if a$<>chr$(147) then 2130
2000 t2=0
2010 tm=0
2020 gosub 2790
2030 ee=1
2040 op=0
2050 er=0
2060 em=0:gosub 3540:rem erase message
2070 k0%=k1%
2080 k1%=21
2090 k2%=k3%
2100 k3%=k1%
2110 goto 2240
2120 rem evaluate off
2130 if a$<>"q" then 410
2132 xq=pos(1)
2140 em=4:gosub 3540:rem display prompt
2150 a$="":get a$:if a$="" then 2150
2160 if a$="y" then 2190
2170 poke781,24:sys59903:rem erase prompt
2172 poke214,0:print:printtab(xq)"";
2180 goto 410
2190 poke788,49:goto40000
2230 rem light up keys
2240 if k0%<0 then 2310
2250 ad=1034+k%(k0%)
2260 poke ad,peek(ad) or 128
2270 ad=ad+1
2280 poke ad,peek(ad) or 128
2290 ad=ad+1
2300 poke ad,peek(ad) or 128
2310 if k1%<0 then 2380
2320 ad=1034+k%(k1%)
2330 poke ad,peek(ad) and 127
2340 ad=ad+1
2350 poke ad,peek(ad) and 127
2360 ad=ad+1
2370 poke ad,peek(ad) and 127
2380 if k2%<0 then 410
2390 ad=1034+k%(k2%)
2400 poke ad,peek(ad) or 128
2410 ad=ad+1
2420 poke ad,peek(ad) or 128
2430 ad=ad+1
2440 poke ad,peek(ad) or 128
2450 goto 410
2460 rem evaluate prev operation
2470 if ee=0 then gosub 3290
2480 ee=1
2490 if er then return
2500 on op+1 goto 2510, 2560, 2590, 2620, 2650, 2690, 2740
2510 rem null operator
2520 tm=t2+t1
2530 t1=0
2540 return
2550 rem addition
2560 tm=tm+t1
2570 goto 2790
2580 rem subtraction
2590 tm=tm-t1
2600 goto 2790
2610 rem multiplication
2620 tm=tm*t1
2630 goto 2790
2640 rem division
2650 if t1=0 then em=3:goto 3470
2660 tm=tm/t1
2670 goto 2790
2680 rem logical and
2690 if t1>32767 then t1=t1-65536
2700 if tm>32767 then tm=tm-65536
2710 tm=tm and t1
2720 goto 2790
2730 rem logical or
2740 if t1>32767 then t1=t1-65536
2750 if tm>32767 then tm=tm-65536
2760 tm=tm or t1
2770 goto 2790
2780 rem display result
2790 t1=0:t0=tm
2800 gosub 3210
2810 if md>0 then 2890
2820 rem display decimal
2830 if em>0 then em=0:gosub 3540
2840 t0$=str$(t0)
2850 la=la+len(t0$)
2860 print t0$;
2870 return
2880 rem hex conversion
2890 if t0<-32768 then 3100
2900 if t0> 65535 then 3100
2910 n=sgn(t0)*int(abs(t0))
2920 t0=n
2930 m=-16:rem leading space
2940 if n>=0 then 2970
2950 m= 15:rem leading f
2960 n=n+65536
2970 gosub 3160
2980 m=int(n/4096)
2990 gosub 3160
3000 n=n-4096*m
3010 m=int(n/256)
3020 gosub 3160
3030 n=n-256*m
3040 m=int(n/16)
3050 gosub 3160
3060 m=n-16*m
3070 gosub 3160
3080 return
3090 rem hex overflow
3100 print "overflow";
3110 la=la+8
3120 em=2
3130 gosub 3540:rem display message
3140 return
3150 rem display hex digit
3160 if m<10 then hx$=chr$(48+m)
3170 if m>=10 then hx$=chr$(55+m)
3180 print hx$;
3190 la=la+1
3200 return
3210 rem erase input
3220 if la=0 then return
3230 for i=1 to la
3240 print "[157] [157]";
3250 next i
3260 la=0
3270 return
3280 rem evaluate input string
3290 if la=0 then return
3300 t1=0
3310 for i=1 to la
3320 aa$=t$(i)
3330 if aa$<"0" or aa$>"9" then 3370
3340 t1=t1*ba
3350 t1=t1+asc(aa$)-48
3360 goto 3400
3370 if aa$<"a" or aa$>"f" then 3400
3380 t1=t1*ba
3390 t1=t1+asc(aa$)-55
3400 next i
3410 if md<0 then return
3420 rem check sign bit
3430 if t1>65535 then t1=t1-1048576
3440 if t1>-32769 then return
3450 em=1
3460 rem input error
3470 gosub 3210
3480 print "error";
3490 la=5
3500 gosub 3540:rem display message
3510 er=1
3520 return
3530 rem display error message
3540 am=2003
3550 for i=0 to 19
3560 am=am+1
3570 poke am,vm(i,em)
3580 next
3590 return
3600 rem initialize array of key posns
3610 k%( 0)=891
3620 k%( 1)=771
3630 k%( 2)=776
3640 k%( 3)=781
3650 k%( 4)=651
3660 k%( 5)=656
3670 k%( 6)=661
3680 k%( 7)=531
3690 k%( 8)=536
3700 k%( 9)=541
3710 k%(10)=411
3720 k%(11)=416
3730 k%(12)=421
3740 k%(13)=291
3750 k%(14)=296
3760 k%(15)=301
3770 k%(16)=546
3780 k%(17)=426
3790 k%(18)=666
3800 k%(19)=786
3810 k%(20)=906
3820 k%(21)=306
3830 k%(22)=896
3840 k%(23)=901
3850 k%(24)=171
3860 k%(25)=176
3870 k%(26)=181
3880 k%(27)=186
3890 rem initialize error message array
3900 for j=0 to 4
3910 for i=0 to 19
3920 read vm(i,j)
3940 next
3950 next
3960 return
3970 data 160,160,160,160,160
3980 data 160,160,160,160,160
3990 data 160,1